﻿Imports System.Xml
Imports System.Collections.Generic
Imports System.Collections.Specialized
Imports System.Configuration.Provider
Imports System.Web.Security
Imports System.Web.Hosting
Imports System.Web.Management
Imports System.Security.Permissions
Imports System.Web
Imports System.Text
Imports System.IO

Public Class XmlRoleProvider
    Inherits RoleProvider

    Private _UsersAndRoles As New Dictionary(Of String, String())(16, StringComparer.InvariantCultureIgnoreCase)
    Private _RolesAndUsers As New Dictionary(Of String, String())(16, StringComparer.InvariantCultureIgnoreCase)
    Private _Roles As New Dictionary(Of String, String)(16, StringComparer.InvariantCultureIgnoreCase)
    Private _XmlUserRoleFileName As String
    Private _XmlRoleFileName As String
    Private _AppName As String

    ' not used right now, for future
    Public Overrides Property ApplicationName() As String
        Get
            Return _AppName
        End Get
        Set(ByVal value As String)
            If value.Length > 256 Then
                Throw New ProviderException("ApplicationName too long - cannot exceed 256 characters in length")
            End If
            _AppName = value
        End Set
    End Property


    Public Overrides Sub Initialize(ByVal name As String, ByVal config As NameValueCollection)
        ' Verify that config isn't null
        If config Is Nothing Then
            Throw New ArgumentNullException("config")
        End If

        ' Assign the provider a default name if it doesn't have one
        If [String].IsNullOrEmpty(name) Then
            name = "AspNetXmlRoleProvider"
        End If

        ' Add a default "description" attribute to config if the
        ' attribute doesn't exist or is empty
        If String.IsNullOrEmpty(config("description")) Then
            config.Remove("description")
            config.Add("description", "XML Role Provider")
        End If
        ' Add a default "description" attribute to config if the
        ' attribute doesn't exist or is empty
        If String.IsNullOrEmpty(config("applicationName")) Then
            config.Remove("applicationName")
            config.Add("applicationName", "app name")
        End If
        config.Remove("applicationName")

        ' Call the base class's Initialize method
        MyBase.Initialize(name, config)

        '---------------------------------------------------------------
        ' Initialize _xmlUserRoleFileName and make sure the path
        ' is app-relative
        Dim path As String = config("xmlUserRoleFileName")
        If [String].IsNullOrEmpty(path) Then
            path = "~/App_Data/UserRoles.xml"
        End If
        If Not VirtualPathUtility.IsAppRelative(path) Then
            Throw New ArgumentException("xmlUserRoleFileName must be app-relative")
        End If
        Dim fullyQualifiedPath As String = VirtualPathUtility.Combine(VirtualPathUtility.AppendTrailingSlash(HttpRuntime.AppDomainAppVirtualPath), path)
        _XmlUserRoleFileName = HostingEnvironment.MapPath(fullyQualifiedPath)
        config.Remove("xmlUserRoleFileName")
        ' Make sure we have permission to read the XML data source and
        ' throw an exception if we don't
        Dim permission As New FileIOPermission(FileIOPermissionAccess.Read, _XmlUserRoleFileName)
        permission.Demand()
        '-------------------------------------------------------------
        ' Initialize _xmlUserRoleFileName and make sure the path
        ' is app-relative
        Dim path2 As String = config("xmlRoleFileName")
        If [String].IsNullOrEmpty(path2) Then
            path = "~/App_Data/Roles.xml"
        End If
        If Not VirtualPathUtility.IsAppRelative(path2) Then
            Throw New ArgumentException("xmlRoleFileName must be app-relative")
        End If
        Dim fullyQualifiedPath2 As String = VirtualPathUtility.Combine(VirtualPathUtility.AppendTrailingSlash(HttpRuntime.AppDomainAppVirtualPath), path2)
        _XmlRoleFileName = HostingEnvironment.MapPath(fullyQualifiedPath2)
        config.Remove("xmlRoleFileName")
        ' Make sure we have permission to read the XML data source and
        ' throw an exception if we don't
        Dim permission2 As New FileIOPermission(FileIOPermissionAccess.Read, _XmlRoleFileName)
        permission2.Demand()
        '-------------------------------------------------------------

        ' Throw an exception if unrecognized attributes remain
        If config.Count > 0 Then
            Dim attr As String = config.GetKey(0)
            If Not [String].IsNullOrEmpty(attr) Then
                Throw New ProviderException("Unrecognized attribute: " & attr)
            End If
        End If

        ReadRoleDataStore()
    End Sub

    Public Overrides Function GetAllRoles() As String()
        Dim i As Integer = 0
        Dim roles As String() = New String(_Roles.Count - 1) {}
        For Each pair As KeyValuePair(Of String, String) In _Roles
            roles(System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)) = pair.Key
        Next
        Return roles
    End Function

    Public Overrides Function GetRolesForUser(ByVal username As String) As String()
        ' Validate input parameters
        If username Is Nothing Then
            Throw New ArgumentNullException()
        End If
        If username = String.Empty Then
            Throw New ArgumentException()
        End If

        ' Make sure the user name is valid
        Dim roles As String()
        If Not _UsersAndRoles.TryGetValue(username, roles) Then
            Throw New ProviderException("Invalid user name")
        End If

        ' Return role names
        Return roles
    End Function

    Public Overrides Function GetUsersInRole(ByVal roleName As String) As String()
        ' Validate input parameters
        If roleName Is Nothing Then
            Throw New ArgumentNullException()
        End If
        If roleName = String.Empty Then
            Throw New ArgumentException()
        End If

        ' Make sure the role name is valid
        Dim users As String()
        If Not _RolesAndUsers.TryGetValue(roleName, users) Then
            Throw New ProviderException("Invalid role name")
        End If

        ' Return user names
        Return users
    End Function

    Public Overrides Function IsUserInRole(ByVal username As String, ByVal roleName As String) As Boolean
        ' Validate input parameters
        If username Is Nothing OrElse roleName Is Nothing Then
            Throw New ArgumentNullException()
        End If
        If username = [String].Empty OrElse roleName = String.Empty Then
            Throw New ArgumentException()
        End If

        ' Make sure the user name and role name are valid
        If Not _Roles.ContainsKey(roleName) Then
            Throw New ProviderException("Invalid role name")
        End If
        If Not _UsersAndRoles.ContainsKey(username) Then
            'Throw New ProviderException("Invalid user name")
            GenerateNewEntry(username)
        End If

        ' Determine whether the user is in the specified role    
        Dim roles As String() = _UsersAndRoles(username)
        For Each role As String In roles
            If [String].Compare(role, roleName, True) = 0 And roleName <> "Member" Then
                Return True
            End If
        Next

        Return False
    End Function

    Public Overrides Function RoleExists(ByVal roleName As String) As Boolean
        ' Validate input parameters
        If roleName Is Nothing Then
            Throw New ArgumentNullException()
        End If
        If roleName = String.Empty Then
            Throw New ArgumentException()
        End If

        ' Determine whether the role exists
        Return _Roles.ContainsKey(roleName)
    End Function

    Public Overrides Sub AddUsersToRoles(ByVal usernames As String(), ByVal roleNames As String())

        Try
            SyncLock Me
                For Each rolename As String In roleNames
                    If Not RoleExists(rolename) Then
                        Throw New ProviderException("Role name not found.")
                    End If
                Next
                For Each username As String In usernames
                    If username.IndexOf(","c) > 0 Then
                        Throw New ArgumentException("User names cannot contain commas.")
                    End If
                    For Each rolename As String In roleNames
                        If IsUserInRole(username, rolename) Then
                            Throw New ProviderException("User is already in role.")
                        Else
                            If Not rolename = "Member" Then
                                Dim ur As String() = GetRolesForUser(username)
                                Array.Resize(ur, ur.Length + 1)
                                ur(ur.GetUpperBound(0)) = rolename
                                _UsersAndRoles.Remove(username)
                                _UsersAndRoles.Add(username, ur)
                            End If
                        End If
                    Next
                Next

                
                SaveDataStore()
                ReadRoleDataStore()
            End SyncLock
        Catch
            Throw
        End Try
    End Sub

    Public Overrides Sub CreateRole(ByVal roleName As String)
        Try
            SyncLock Me
                If _Roles.ContainsKey(roleName) Then
                    Throw New ProviderException("Role name already exists.")
                End If
                _Roles.Add(roleName, "")
                Using sw As New StreamWriter(_XmlRoleFileName, False)
                    Using writer As New XmlTextWriter(sw)
                        writer.Formatting = Formatting.Indented

                        writer.WriteStartDocument()
                        writer.WriteStartElement("Roles")

                        For Each r In _Roles
                            writer.WriteStartElement("Role")
                            writer.WriteElementString("RoleName", r.Key)
                            writer.WriteElementString("RoleDescription", r.Value)
                            writer.WriteEndElement()
                        Next

                        writer.WriteEndElement()
                        writer.WriteEndDocument()

                        writer.Close()
                    End Using
                    sw.Close()
                End Using
            End SyncLock
        Catch
            Throw
        End Try
    End Sub

    Public Overrides Function DeleteRole(ByVal roleName As String, ByVal throwOnPopulatedRole As Boolean) As Boolean
        Throw New NotSupportedException()
        Try
            SyncLock Me

                If Not _Roles.ContainsKey(roleName) Then
                    Throw New ProviderException("Role name doesn't exists.")
                End If
                _Roles.Remove(roleName)
                Using sw As New StreamWriter(_XmlRoleFileName, False)
                    Using writer As New XmlTextWriter(sw)
                        writer.Formatting = Formatting.Indented

                        writer.WriteStartDocument()
                        writer.WriteStartElement("Roles")

                        For Each r In _Roles
                            writer.WriteStartElement("Role")
                            writer.WriteElementString("RoleName", r.Key)
                            writer.WriteElementString("RoleDescription", r.Value)
                            writer.WriteEndElement()
                        Next

                        writer.WriteEndElement()
                        writer.WriteEndDocument()

                        writer.Close()
                    End Using
                    sw.Close()
                End Using
            End SyncLock
        Catch
            Throw
        End Try
    End Function

    Public Overrides Function FindUsersInRole(ByVal roleName As String, ByVal usernameToMatch As String) As String()
        Throw New NotSupportedException()
    End Function

    Public Overrides Sub RemoveUsersFromRoles(ByVal usernames As String(), ByVal roleNames As String())
        'Throw New NotSupportedException()

        Try
            SyncLock Me
                For Each username As String In usernames
                    Dim ur As String() = GetRolesForUser(username)
                    Dim ur2 As String() = ur.Clone
                    Array.Clear(ur2, 0, ur2.Length)
                    Array.Resize(ur2, 0)
                    For Each rolename As String In ur
                        'For Each r As String In ur
                        If Not roleNames.Contains(rolename) Then
                            Array.Resize(ur2, ur2.Length + 1)
                            ur2(ur2.GetUpperBound(0)) = rolename
                        End If
                        'Next
                        _UsersAndRoles.Remove(username)
                        _UsersAndRoles.Add(username, ur2)
                    Next
                Next


                SaveDataStore()
                ReadRoleDataStore()
            End SyncLock
        Catch
            Throw
        End Try

    End Sub

    Private Sub GenerateNewEntry(ByVal username As String)
        Dim s As String = "Member"
        _UsersAndRoles.Add(username, s.Split(","))
        SaveDataStore()
    End Sub
    ' Helper method
    Private Sub ReadRoleDataStore()
        _UsersAndRoles.Clear()
        _RolesAndUsers.Clear()
        _Roles.Clear()
        Dim doc As New XmlDocument()
        doc.Load(_XmlUserRoleFileName)
        Dim nodes As XmlNodeList = doc.GetElementsByTagName("User")

        For Each node As XmlNode In nodes
            If node("UserName") Is Nothing Then
                Throw New ProviderException("Missing UserName element")
            End If

            Dim user As String = node("UserName").InnerText
            If [String].IsNullOrEmpty(user) Then
                Throw New ProviderException("Empty UserName element")
            End If

            If node("Roles") Is Nothing OrElse [String].IsNullOrEmpty(node("Roles").InnerText) Then
                _UsersAndRoles.Add(user, New String(-1) {})
            Else
                Dim roles As String() = node("Roles").InnerText.Split(","c)

                ' Add the role names to _UsersAndRoles and
                ' key them by user name
                _UsersAndRoles.Add(user, roles)

                For Each role As String In roles
                    ' Add the user name to _RolesAndUsers and
                    ' key it by role names
                    Dim users1 As String()

                    If _RolesAndUsers.TryGetValue(role, users1) Then
                        Dim users2 As String() = New String(users1.Length) {}
                        users1.CopyTo(users2, 0)
                        users2(users1.Length) = user
                        _RolesAndUsers.Remove(role)
                        _RolesAndUsers.Add(role, users2)
                    Else
                        _RolesAndUsers.Add(role, New String() {user})
                    End If
                Next
            End If
        Next

        '--- Roles
        Dim doc2 As New XmlDocument()
        doc2.Load(_XmlRoleFileName)
        Dim nodes2 As XmlNodeList = doc2.GetElementsByTagName("Role")
        For Each node2 As XmlNode In nodes2
            If node2("RoleName") Is Nothing Then
                Throw New ProviderException("Missing RoleName element")
            End If
            Dim r As String = node2("RoleName").InnerText
            If [String].IsNullOrEmpty(r) Then
                Throw New ProviderException("Empty RoleName element")
            End If
            _Roles.Add(node2("RoleName").InnerText, node2("RoleDescription").InnerText)
        Next
    End Sub

    Private Sub SaveDataStore()
        Using sw As New StreamWriter(_XmlUserRoleFileName, False)
            Using writer As New XmlTextWriter(sw)
                writer.Formatting = Formatting.Indented

                writer.WriteStartDocument()
                writer.WriteStartElement("Users")

                For Each u In _UsersAndRoles
                    writer.WriteStartElement("User")
                    writer.WriteElementString("UserName", u.Key)
                    Dim _roles As String = String.Empty
                    For Each r In u.Value
                        If Not u.Value.ToString.Length = 0 Then
                            _roles += r & ","
                        End If
                    Next
                    _roles = _roles.Substring(0, _roles.Length - 1)
                    writer.WriteElementString("Roles", _roles)
                    writer.WriteEndElement()
                Next

                writer.WriteEndElement()
                writer.WriteEndDocument()

                writer.Close()
            End Using
            sw.Close()
        End Using
    End Sub
End Class
